home *** CD-ROM | disk | FTP | other *** search
VERSION 5.00 Begin VB.Form frmTestMsgBoxEx BorderStyle = 1 'Fixed Single Caption = "Testing VBI MsgBox" ClientHeight = 5025 ClientLeft = 45 ClientTop = 330 ClientWidth = 6945 Icon = "TestMsgBoxEx.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 5025 ScaleWidth = 6945 StartUpPosition = 2 'CenterScreen Begin VB.Frame fraCustomIcon Caption = "Custom Icon" ForeColor = &H80000002& Height = 1335 Left = 3240 TabIndex = 30 Top = 3240 Width = 3615 Begin VB.OptionButton optCustomIcon Caption = "Fax" Height = 255 Index = 2 Left = 120 TabIndex = 33 Top = 840 Width = 735 End Begin VB.OptionButton optCustomIcon Caption = "Car" Height = 255 Index = 1 Left = 1560 TabIndex = 32 Top = 360 Width = 735 End Begin VB.OptionButton optCustomIcon Caption = "None" Height = 255 Index = 0 Left = 120 TabIndex = 31 Top = 360 Value = -1 'True Width = 735 End Begin VB.Image ImgIcon Height = 480 Index = 2 Left = 960 Picture = "TestMsgBoxEx.frx":000C Top = 720 Width = 480 End Begin VB.Image ImgIcon Height = 480 Index = 1 Left = 2400 Picture = "TestMsgBoxEx.frx":0316 Top = 240 Width = 480 End Begin VB.Image ImgIcon Height = 360 Index = 0 Left = 960 Top = 240 Width = 480 End End Begin VB.Frame fraDefault Caption = "Default Button" ForeColor = &H80000002& Height = 1455 Left = 1920 TabIndex = 25 Top = 2760 Width = 1215 Begin VB.OptionButton optDefault Caption = "Button 4" Height = 195 Index = 3 Left = 120 TabIndex = 29 Tag = "768" Top = 1080 Width = 975 End Begin VB.OptionButton optDefault Caption = "Button 3" Height = 195 Index = 2 Left = 120 TabIndex = 28 Tag = "512" Top = 840 Width = 975 End Begin VB.OptionButton optDefault Caption = "Button 2" Height = 195 Index = 1 Left = 120 TabIndex = 27 Tag = "256" Top = 600 Width = 975 End Begin VB.OptionButton optDefault Caption = "Button 1" Height = 195 Index = 0 Left = 120 TabIndex = 26 Tag = "0" Top = 360 Value = -1 'True Width = 975 End End Begin VB.Frame fraIcon Caption = "Icons" ForeColor = &H80000002& Height = 3015 Left = 5400 TabIndex = 19 Top = 120 Width = 1455 Begin VB.CheckBox chkFlash Caption = "Flash Icon" Height = 255 Left = 120 TabIndex = 35 Top = 1920 Width = 1095 End Begin VB.OptionButton optIcon Caption = "None" Height = 255 Index = 4 Left = 120 TabIndex = 24 Tag = "0" Top = 360 Value = -1 'True Width = 1215 End Begin VB.OptionButton optIcon Caption = "Information" Height = 255 Index = 3 Left = 120 TabIndex = 23 Tag = "64" Top = 1320 Width = 1215 End Begin VB.OptionButton optIcon Caption = "Exclamation" Height = 255 Index = 2 Left = 120 TabIndex = 22 Tag = "48" Top = 1080 Width = 1215 End Begin VB.OptionButton optIcon Caption = "Question" Height = 255 Index = 1 Left = 120 TabIndex = 21 Tag = "32" Top = 840 Width = 1215 End Begin VB.OptionButton optIcon Caption = "Critical" Height = 255 Index = 0 Left = 120 TabIndex = 20 Tag = "16" Top = 600 Width = 1215 End End Begin VB.Frame fraColor Caption = "Forecolor" ForeColor = &H80000002& Height = 1455 Left = 0 TabIndex = 10 Top = 2760 Width = 1815 Begin VB.OptionButton optcolor Caption = "White" ForeColor = &H80000014& Height = 255 Index = 5 Left = 960 TabIndex = 16 Top = 840 Width = 800 End Begin VB.OptionButton optcolor Caption = "Purple" ForeColor = &H00C000C0& Height = 255 Index = 4 Left = 960 TabIndex = 15 Top = 600 Width = 800 End Begin VB.OptionButton optcolor Caption = "Green" ForeColor = &H00008000& Height = 255 Index = 3 Left = 960 TabIndex = 14 Top = 360 Width = 800 End Begin VB.OptionButton optcolor Caption = "Red" ForeColor = &H000000FF& Height = 255 Index = 2 Left = 120 TabIndex = 13 Top = 840 Width = 735 End Begin VB.OptionButton optcolor Caption = "Blue" ForeColor = &H00FF0000& Height = 255 Index = 1 Left = 120 TabIndex = 12 Top = 600 Width = 735 End Begin VB.OptionButton optcolor Caption = "Black" Height = 255 Index = 0 Left = 120 TabIndex = 11 Top = 360 Value = -1 'True Width = 735 End End Begin VB.Frame fraPrompt Caption = "Message" ForeColor = &H80000002& Height = 2535 Left = 0 TabIndex = 9 Top = 120 Width = 3135 Begin VB.CheckBox chkBold Caption = "Bold Font" Height = 255 Left = 120 TabIndex = 38 Top = 2160 Width = 1095 End Begin VB.TextBox txtTitle Height = 375 Left = 120 TabIndex = 18 Text = "Invalid Card Number" Top = 240 Width = 2895 End Begin VB.TextBox txtPrompt Height = 1335 Left = 120 MultiLine = -1 'True TabIndex = 0 Text = "TestMsgBoxEx.frx":0758 Top = 720 Width = 2895 End End Begin VB.Frame fraButtons Caption = "Buttons" ForeColor = &H80000002& Height = 3015 Left = 3240 TabIndex = 2 Top = 120 Width = 2055 Begin VB.CheckBox chkHelpButton Caption = "Help Button" Height = 255 Left = 120 TabIndex = 37 Top = 2640 Width = 1335 End Begin VB.CheckBox chkActive Caption = "Active Borders" Height = 255 Left = 120 TabIndex = 36 Top = 2280 Width = 1575 End Begin VB.CheckBox chkGraphicalButtons Caption = "Graphical Buttons" Height = 255 Left = 120 TabIndex = 34 Top = 2040 Width = 1575 End Begin VB.OptionButton optButton Caption = "Retry / Cancel" Height = 255 Index = 5 Left = 120 TabIndex = 8 Top = 1560 Width = 1880 End Begin VB.OptionButton optButton Caption = "Yes / No" Height = 255 Index = 4 Left = 120 TabIndex = 7 Top = 1320 Width = 1880 End Begin VB.OptionButton optButton Caption = "Yes / No / Cancel" Height = 255 Index = 3 Left = 120 TabIndex = 6 Top = 1080 Width = 1880 End Begin VB.OptionButton optButton Caption = "Abort / Retry / Ignore" Height = 255 Index = 2 Left = 120 TabIndex = 5 Top = 840 Width = 1880 End Begin VB.OptionButton optButton Caption = "Ok / Cancel" Height = 255 Index = 1 Left = 120 TabIndex = 4 Top = 600 Width = 1695 End Begin VB.OptionButton optButton Caption = "Ok" Height = 255 Index = 0 Left = 120 TabIndex = 3 Top = 360 Value = -1 'True Width = 1095 End End Begin VB.CommandButton cmdTest Caption = "Test" Height = 495 Left = 120 TabIndex = 1 Top = 4440 Width = 1215 End Begin VB.Label lblWeb Alignment = 2 'Center BackStyle = 0 'Transparent Caption = "http://home.tampabay.rr.com/jmiko/" BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H00FF0000& Height = 255 Left = 3240 MouseIcon = "TestMsgBoxEx.frx":0780 MousePointer = 99 'Custom TabIndex = 39 Top = 4680 Width = 3615 End Begin VB.Label lblResult Alignment = 2 'Center BeginProperty Font Name = "MS Sans Serif" Size = 9.75 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty Height = 375 Left = 1680 TabIndex = 17 Top = 4560 Width = 1335 End Attribute VB_Name = "frmTestMsgBoxEx" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Option Explicit Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long Dim MsgIcon As Long Dim MsgButtons As Long Dim MsgDefButton As Long Dim MsgForeColor As Long Dim MsgCustomIcon As Variant Private Sub Form_Load() 'Default Forecolor MsgForeColor = vbButtonText End Sub Private Sub lblWeb_Click() Dim rc As Long rc = ShellExecute(0&, "open", lblWeb.Caption, vbNullString, vbNullString, 1&) End Sub Private Sub optButton_Click(Index As Integer) 'Index corresponds to VbMsgBoxStyle constants MsgButtons = Index End Sub Private Sub optcolor_Click(Index As Integer) 'Use Forecolor of selected option control MsgForeColor = optcolor(Index).ForeColor End Sub Private Sub optCustomIcon_Click(Index As Integer) Set MsgCustomIcon = ImgIcon(Index).Picture End Sub Private Sub optDefault_Click(Index As Integer) Select Case Index Case 0: MsgDefButton = vbDefaultButton1 Case 1: MsgDefButton = vbDefaultButton2 Case 2: MsgDefButton = vbDefaultButton3 Case 3: MsgDefButton = vbDefaultButton4 Case Else: MsgDefButton = vbDefaultButton1 End Select End Sub Private Sub optIcon_Click(Index As Integer) Select Case Index Case 0: MsgIcon = vbCritical Case 1: MsgIcon = vbQuestion Case 2: MsgIcon = vbExclamation Case 3: MsgIcon = vbInformation Case Else: MsgIcon = 0 'No Icon End Select End Sub Private Sub cmdTest_Click() Dim Flags As VbMsgBoxStyle Dim Result As VbMsgBoxResult Dim BtnStyle As vbMsgBoxExButtonStyles 'Reset label caption lblResult.Caption = "" 'Set initial style based on VbMsgBoxStyle constants Flags = MsgButtons + MsgIcon + MsgDefButton 'Add help button to flags if checked If chkHelpButton.Value = vbChecked Then Flags = Flags + vbMsgBoxHelpButton Select Case True Case (chkGraphicalButtons.Value = vbChecked) And (chkActive.Value = vbChecked) BtnStyle = btnActiveGraphical Case (chkGraphicalButtons.Value = vbChecked) And (chkActive.Value = vbUnchecked) BtnStyle = btnGraphical Case chkActive.Value = vbChecked BtnStyle = btnActive Case Else BtnStyle = btnStandard End Select 'If help button selected then pass bogus help file If chkHelpButton.Value = vbChecked Then Result = MsgBoxEx(txtPrompt, Flags, txtTitle, "C:\NoHelp.hlp", 1, (chkFlash.Value = vbChecked), MsgForeColor, (chkBold.Value = vbChecked), BtnStyle, MsgCustomIcon) Else Result = MsgBoxEx(txtPrompt, Flags, txtTitle, , , (chkFlash.Value = vbChecked), MsgForeColor, (chkBold.Value = vbChecked), BtnStyle, MsgCustomIcon) End If Select Case Result Case vbOK: lblResult = "Ok Button" Case vbCancel: lblResult = "Cancel Button" Case vbAbort: lblResult = "Abort Button" Case vbRetry: lblResult = "Retry Button" Case vbIgnore: lblResult = "Ignore Button" Case vbYes: lblResult = "Yes Button" Case vbNo: lblResult = "No Button" End Select End Sub 
(.txt)